home *** CD-ROM | disk | FTP | other *** search
/ Windows Expert / Windows Expert.iso / windownt / perlnt.zip / t / io / filetest.nt < prev    next >
Text File  |  1993-07-25  |  5KB  |  182 lines
  1. #
  2. # Test various file test operators.
  3. # Also test file handle stuff that isn't tested elsewhere.
  4. #
  5.  
  6. print "1..30\n";
  7.  
  8. $tfile = "test.tmp";
  9.  
  10. if (-e $tfile)  {
  11.     chmod (0666, $tfile);
  12.     unlink $tfile;
  13. }
  14. open (T, ">$tfile") || die "can't open temp file\n";
  15.  
  16. print T "Test data\n";
  17.  
  18. close(T);
  19.  
  20. #
  21. # Check that -r/-R and -w/-W do the same thing
  22. #
  23. # N.B. ownership tests are meaningless right now!
  24. #
  25.  
  26. if (-w "$tfile") {print "ok 1\n";} else {print "not ok 1\n";}
  27. if (-r "$tfile") {print "ok 2\n";} else {print "not ok 2\n";}
  28. if (-o "$tfile") {print "ok 3\n";} else {print "not ok 3\n";}
  29. if (-R "$tfile") {print "ok 4\n";} else {print "not ok 4\n";}
  30. if (-W "$tfile") {print "ok 5\n";} else {print "not ok 5\n";}
  31. if (-O "$tfile") {print "ok 6\n";} else {print "not ok 6\n";}
  32.  
  33. #
  34. # make sure that -x works only on extension, not modes
  35. #
  36.  
  37. chmod (0777, $tfile);
  38. if (-x "$tfile") {print "not ok 7\n";} else {print "ok 7\n";}
  39. if (-X "$tfile") {print "not ok 8\n";} else {print "ok 8\n";}
  40.  
  41. unlink "foo.exe" if -e "foo.exe";
  42. open(T, ">foo.exe") || die "can't open foo.exe for writing\n";
  43. print T "foo";
  44. close(T);
  45.  
  46. #
  47. # check various extension types
  48. # 
  49. # N.B. NTFS has an execute permission. We'll need to insure that this
  50. # is honored later.
  51. #
  52. if (-x "foo.exe") {print "ok 9\n";} else {print "not ok 9\n";}
  53. rename ("foo.exe", "foo.cmd") || die "Can't rename foo.exe to foo.cmd\n";
  54. if (-x "foo.cmd") {print "ok 10\n";} else {print "not ok 10\n";}
  55. rename ("foo.cmd", "foo.bat") || die "Can't rename foo.cmd to foo.bat\n";
  56. if (-x "foo.bat") {print "ok 11\n";} else {print "not ok 11\n";}
  57. rename ("foo.bat", "foo.com") || die "Can't rename foo.bat to foo.com\n";
  58. if (-x "foo.com") {print "ok 12\n";} else {print "not ok 12\n";}
  59.  
  60. unlink "foo.com";
  61.  
  62. #
  63. # check that writability is affected when we turn off the write bits
  64. #
  65.  
  66. chmod (0111, $tfile);
  67. if (-w "$tfile") {print "not ok 13\n";} else {print "ok 13\n";}
  68. if (-W "$tfile") {print "not ok 14\n";} else {print "ok 14\n";}
  69.  
  70. #
  71. # Check that these don't work!
  72. #
  73.  
  74. if (-S $tfile) {print "not ok 15\n";} else {print "ok 15\n";}
  75. if (-l $tfile) {print "not ok 16\n";} else {print "ok 16\n";}
  76. if (-p $tfile) {print "not ok 17\n";} else {print "ok 17\n";}
  77.  
  78. #
  79. # Test Binary vs. Text test
  80. #
  81.  
  82. if (-B $tfile) {print "not ok 18\n";} else {print "ok 18\n";}
  83. if (-T $tfile) {print "ok 19\n";} else {print "not ok 19\n";}
  84.  
  85. chmod (0666, $tfile);
  86. unlink $tfile;
  87.  
  88. open (T, ">$tfile") || die "Can't create $tfile\n";
  89. binmode(T);
  90. print T "\001\002\003\004\005\006\007\010\011\012\013";
  91. close (T);
  92.  
  93. if (-B $tfile) {print "ok 20\n";} else {print "not ok 20\n";}
  94. if (-T $tfile) {print "not ok 21\n";} else {print "ok 21\n";}
  95.  
  96. if (-e $tfile) {print "ok 22\n";} else {print "not ok 22\n";}
  97. if (-s $tfile) {print "ok 23\n";} else {print "not ok 23\n";}
  98.  
  99. truncate($tfile, 10) || die "can't truncate $tfile to 10 bytes\n";
  100. ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size) = stat($tfile);
  101. if ($size == 10) {print "ok 24\n";} else {print "not ok 24\n";}
  102.  
  103. truncate($tfile, 0) || die "can't truncate $tfile to 0 bytes\n";
  104. if (-z $tfile) {print "ok 25\n";} else {print "not ok 25\n";}
  105. open (T, ">$tfile") || die "can't open $tfile\n";
  106. print T "foo\n";
  107. close(T);
  108. if (-z $tfile) {print "not ok 26\n";} else {print "ok 26\n";}
  109.  
  110. if (-f $tfile) {print "ok 27\n";} else {print "not ok 27\n";}
  111.  
  112. unlink $tfile;
  113.  
  114. #
  115. # check that -t works with STDIN being a file (i.e. returns false)
  116. #
  117.  
  118. open (T, ">$tfile") || die "Can't open $tfile for writing\n";
  119. print T 'if (-t) {print "not";} else {print "ok";}';
  120. close T;
  121. $x = `perl $tfile <$tfile`;
  122. if ($x eq "ok") {print "ok 28\n";} else {print "not ok 28\n";}
  123.  
  124. unlink $tfile;
  125.  
  126. #
  127. # check that the Here-is operator works
  128. #
  129. open (T, ">$tfile") || die "Can't open $tfile for writing: $!\n";
  130. print T <<"HERE_IS_TEST";
  131. This is a test of the here-is mechanism. 
  132. It was written to a file named $tfile
  133. HERE_IS_TEST
  134. close T;
  135.  
  136. open (T, $tfile) || die "Can't open $tfile for reading: $!\n";
  137. @lines = <T>;
  138. close T;
  139. if (@lines == 2 &&
  140.     split(/ /, @lines[1]) &&
  141.     chop ($_[$#_]) &&
  142.     $_[$#_] eq $tfile) {
  143.     print ("ok 29\n");
  144. }
  145. else {
  146.     print "not ok 29\n";
  147. }
  148.  
  149.  
  150. #
  151. # check that the data file handle works
  152. #
  153.  
  154. @a = (1, 2, 3, 4, 5);
  155. $ok = 1;
  156.  
  157. while (<DATA>) {
  158.     if ($a[0] == $_) {
  159.     shift(@a);
  160.     }
  161.     else {
  162.     $ok = 0;
  163.     last;
  164.     }
  165. }
  166. if ($ok) {print "ok 30\n";} else {print "not ok 30\n";}
  167.  
  168. #
  169. # Don't delete the numbers after the end token! They're what
  170. # the DATA file handle is reading!!!
  171. #
  172. __END__
  173. 1
  174. 2
  175. 3
  176. 4
  177. 5
  178.  
  179.     
  180.     
  181.  
  182.